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— Fsp.Mesa Edited by Sandman on August 31, 1977 1:40 PM 

DIRECTORY 

AltoDcfs: FROM "altodefs", 
SystemDefs: FROM "systemdef s" , 
StringOefs: FROM "s tr ingdefs", 
FSPDefs: FROM "fspdefs"; 

DEFINITIONS FROM FSPDefs; 

FSP: PROGRAM 

IMPORTS StringDefs, SystemDefs EXPORTS FSPDefs, SystemDefs SHARES FSPDefs = PUBLIC 
BEGIN -- Mesa Free Storage Package -- 

-- A set of procedures to manage allocation within a zone. 
-- Coalescing of free nodes occurs during allocation; all 
-- free nodes following a candidate node are merged before 
-- any space is allocated. The logic is derived from a 
-- BCPL program by E. M. McCreight and was suggested by an 
-- exercise in Knuth Volume I, p. 453 #19 

UsedNodeSize: PRIVATE BlockSize » SIZE [inuse NodeHeader]; 
FreeNodeSize: PRIVATE BlockSize = SIZE [free NodeHeader]; 
ZoneHeaderSize: PRIVATE BlockSize = SIZE [ZoneHeader] ; 

ZoneTooSmall: ERROR [POINTER] = CODE; 

DoNothingDeallocate: Deallocator = BEGIN NULL END; 

MakeZone: PROCEDURE [base: POINTER, length: BlockSize] RETURNS [z: ZonePointer] = 
BEGIN 

RETURN[MakeNewZone[base, length, DoNothingDeallocate]]; 
END; 

MakeNewZone: PROCEDURE [base: POINTER, length: BlockSize, deallocate: Deallocator] 
RETURNS [z: ZonePointer] = 
BEGIN 

fn: FreeNodePointer; 
an: NodePointer; 
IF length < ZoneHeaderSize+FreeNodeSize+UsedNodeSize 

THEN ERROR ZoneTooSmall [base] ; 
z *• base; 
-- set up the bulk of the zone as a large free block. 

fn «- base + ZoneHeaderSize; 

fnt 4- NodeHeader[length-(ZoneHeaderSize+UsedNodeSize) , f ree[@z . node, Qz.node]]; 
-- set up an allocated node (the smallest possible) at the end of the block. 

an «- base + ( length-UsedNodeSize) ; 

ant <- NodeHeader[UsedNodeSize, inuse[]]; 
-- set up the zone header 

zt «- ZoneHeader[ 

NodeHeader[0, free[fn, fn]], fn, NIL, length, deallocate, FreeNodeSize, FALSE]; 
RETURN 
END; 

AddToZone: PROCEDURE [z: ZonePointer, base: POINTER, length: BlockSize] = 
BEGIN 

AddToNewZone[z , base, length, DoNothingDeallocate]; 
END; 

AddToNewZone: PROCFDURE [z: ZonePointer, base: POINTER, length: BlockSize, deallocate: Deallocator] 

** 

BEGIN 

newz: ZonePointer; 

firstnew, lastnew: FreeNodePointer; 

Val idateZone[z] ; 

new/ +- MakeNew7one[base , length, deallocate]; 

-- splice the /ones together 

firstnew «- new/ . node . fwdp ; lastnew «- new/ . node . backp ; 

/. node, backp . fwdp ♦■ firstnew; 

f irs tnew. backp «- /. node . backp ; 

lastnew. fwdp «- @z.n ode; 

/.node, backp ♦- lastnew; 
-- make new/ head an empty list 

new/ . node . fwdp <- new/ . node . backp «- Qnewz.node; 
-- link new/ with restof/ones in z 

newz.restof/one «- /.restof/one; 
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z. restof zone <- newz; 
IF z. checking THEN CheckZone[z]; 
RETURN 
END; 

Inval idZone: ERROR [POINTER] = CODE; -- zone header looks fishy 

ValidateZone: PRIVATE PROCEDURE [z: ZonePointer] ■ 
BEGIN 
SELECT TRUE FROM 

(z. node. length # 0) , 

(LOOPHOLE[z + (z.length-UsedNodeSize) , NodePointer] . length # UsedNodeSize) , 

(z. node. fwdp. backp # Qz.node OR z . node. backp . fwdp # Qz. node) => 
ERROR InvalidZone[z]; 

ENDCASE; 
RETURN 
END; 

NodeLoop: ERROR [ZonePointer] = CODE; 

CheckZone: PRIVATE PROCEDURE [z: ZonePointer] = 
BEGIN 

node: FreeNodePointer ; 
count: INTEGER: 
Val idateZone[z] ; 

count ♦- (LAST[BlockSize]-FIRST[BlockSize])/FreeNodeSize + 1; 
node «- 0z . node; 

DO 

CheckNode[z f node]; 

IF (count <- count-1) < THEN ERROR NodeLoop[z]; 

IF (node «- node. fwdp) = Qz.node THEN EXIT; 

ENDLOOP; 
RETURN 
END; 

Inval idNode: ERROR [POINTER] = CODE; -- node appears damaged 

CheckNode: PRIVATE PROCEDURE [z: ZonePointer, node: NodePointer] = 
BEGIN 
DO 

WITH node SELECT FROM 
inuse => 

IF length = UsedNodeSize THEN EXIT; -- end of zone 
free -> 
BEGIN 
IF fwdp.backp # node OR backp.fwdp # node 

THEN GO TO error; 
IF length=0 AND node # Qz.node THEN GO TO error; 
END; 
ENDCASE; 
node ♦- node + node, length; 
IF node. state # inuse THEN EXIT; 
REPEAT 
error => 

BEGIN i, checking <- FALSE; 
ERROR Inval idNode[node+UsedNodeSi ze] ; 
END; 
ENDLOOP; 
RETURN 
END; 

NoRoomlnZone: SIGNAL [ZonePointer] = CODE; -- not enough space to fill a request 

MakeNode: PROCEDURE [z: ZonePointer, n: BlockSize] RETURNS [POINTER] = 
BrGIN 

rover: TreeNodePo i n ter ; 
node, neighbour: NodePointer; 
nodelength, nl, t: BlockSi/e; 
IT /.chocking TIITN Check7one[z] ; 
n +• MAX[n+UsedNodeS i/e , FreeNodeS i /e] ; 
DO 

rover «- ? . rover ; 
DO 

nodelength «- rover . length ; 

FOR neighbour ♦- rover+nodel eng th , neighbour + nl 
DO 
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WITH neighbour SELECT FROM 
inuse => 

EXIT; 
free s > 

BEGIN -- coalesce 

IF (nl ♦■ length) = THEN EXIT; — end of zone 
fwdp.backp «- backp; backp.fwdp ♦• f wdp ; 
z. rover «- rover; — in case neighbor was z. rover 
nodelength «- nodelength+nl ; 
END; 
ENDCASE; 
ENDLOOP; 
IF nodelength >= n 
THEN 
BEGIN 

IF (t <- (nodelength-n)) > MAX[FreeNodeSize, z. threshold] 
THEN 

BEGIN — split the block 
z. rover «- rover; rover. length «- t; 
node ♦" rover+t; nodelength ♦* n; 
END 
ELSE 
BEGIN 

rover . fwdp .backp «- rover. backp; 
z. rover *• rover .backp . fwdp «• rover. fwdp; 
node «- rover; 
END; 
nodet ♦• NodeHeader[nodelength, inuse[]]; 
RETURN [node + UsedNodeSize] 
END 
ELSE rover. length «• nodelength; 
IF (rover <- rover. fwdp) = z. rover THEN EXIT; 
ENDLOOP; 
SIGNAL NoRoomInZone[z]; 

ENDLOOP; — try again if RESUMEd from the signal 
END; 

FreeNode: PROCEDURE [z: ZonePointer, p: POINTER] * 
BEGIN 

node: NodePointer = p-UsedNodeSize; 
IF z. checking THEN CheckZone[z]; 
WITH node SELECT FROM 
free -> 

ERROR InvalidNode[p]; 
ENDCASE => 

nodet <- NodeHeader[node . length , f ree[@z . node, z . node, backp]] ; 
WITH n:node SELECT FROM 
free s > 

z. node, backp «- n. backp. fwdp ♦* Qn; 
ENDCASE; 
RETURN 
END; 

SplitNode: PROCEDURE [z: ZonePointer, p: POINTER, n: BlockSize] = 
BEGIN 

node: NodePointer = p-UsedNodeSize; 
lastpart: NodePointer; 
t: INTEGER; 

IF z. checking THEN CheckZone[z] ; 
n ♦- n+UsedNodeSize; 
WITH node SELECT FROM 
free => 

ERROR Inval idNode[p]; 
ENDCASE => 

IF (t <- node. length - n) > = MAX[FreeNodeS » ze , z. threshold] 
THEN 
BEGIN 

lastpart +- node+n; 

lastpart^ <- NodeHeader[ t , inuse[]]; 
rreeNode[z, lastpar t+UsedNodeS ize] ; 
END; 
RETURN 
END; 

NodeSi/e: PROCEDURE [p: POINTER] RETURNS [BlockSize] = 
BEGIN 
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node: NodePointer = p-UsedNodeSize; 
WITH node SELECT FROM 
free => 

ERROR Inva1idNode[p]; 
ENDCASE *> 

RETURN [length-UsedNodeSize]; 
END; 

PruneZone: PROCEDURE [z: ZonePointer] RETURNS [BOOLEAN] * 
BEGIN 

didit: BOOLEAN <- FALSE; 
rest: ZonePointer; 
headzone, prev: ZonePointer ♦- z; 
node: NodePointer; 
nl : BlockSize; 

FOR z <- z.restofzone, rest UNTIL z = NIL DO 
rest ♦- z. restof zone; 

FOR node <- LOOPHOLE[z+ZoneHeaderSize, NodePointer], node+nl DO 
WITH node SELECT FROM 
inuse a > 
BEGIN 

IF length = UsedNodeSize THEN 
BEGIN -- end of zone 
FreeZone[z]; 
didit <- TRUE; 
prev. restofzone ♦• rest; 
END 
ELSE prev <- z; 
EXIT 
END; 
free => nl <- length; 
ENDCASE; 
ENDLOOP; 
ENDLOOP; 
headzone. rover «- headzone. node. fwdp ; -- reset rover incase it in a zone that was freed 
RETURN[didit]; 
END; 

FreeZone: PROCEDURE [zone: ZonePointer] = 
BEGIN 

node: NodePointer; 
nl : BlockS ize; 

FOR node *- LOOPHOLE[zone+ZoneHeaderSize , NodePointer], node+nl DO 
WITH node SELECT FROM 

inuse => EXIT; -- end of zone 
free => 
BEGIN 

nl «- length; 
backp.fwdp «- fwdp; 
fwdp.backp ♦» backp; 
END; 
ENDCASE; 
ENDLOOP; 
zone. de all ocate[zone]; 
END; 

DestroyZone: PROCEDURE [z: ZonePointer] = 
BEGIN 

rest: ZonePointer; 
IF z = TheHeap THEN RETURN; 
FOR z <- /, rest UNTIL z = NIL DO 

res t «- z . restofzone ; 

z.deallocate[z]; 

ENDLOOP; 
END; 

-- management of the heap 

TheHeap: PRIVATE ZonePointer; 

Heap7one: PROCEDURE RETURNS [ZonePointer] = 
BEGIN 

RETURN [TheHeap] 
END; 
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AllocateHeapNode: PROCEDURE [nwords: CARDINAL] RETURNS [p: POINTER] * 
BEGIN OPEN SystemDefs; 
np: CARDINAL; 

p <- MakeNode[TheHeap , nwords 
INoRoomlnZone => 

BEGIN 

np ♦■ PagesForWords[nwords + ZoneOverhead + UsedNodeSize] ; 

AddToNewZone[TheHeap t AllocatePages[np] , np*AltoDefs .PageSize, FreePages]; 

RESUME 

END]; 
RETURN 
END; 

FreeHeapNode: PROCEDURE [p: POINTER] = 
BEGIN 

FreeNode[TheHeap, p]; RETURN 
END; 

AllocateHeapString: PROCEDURE [nchars: CARDINAL] RETURNS [STRING] = 
BEGIN 

OPEN StringDefs; 

p: POINTER TO MACHINE DEPENDENT RECORD[ — faked string header 
length: CARDINAL, 
maxlength: CARDINAL]; 
p ♦- AllocateHeapNode[WordsForString[nchars]]; 
p. length ♦• 0; p. maxlength ♦• nchars; 
RETURN [LOOPHOLE[p, STRING]] 
END; 

FreeHeapString: PROCEDURE [s: STRING] = 
BEGIN 

FreeNode[TheHeap, s]; RETURN 
END; 

PruneHeap: PROCEDURE RETURNS [BOOLEAN] = 
BEGIN 

RETURN[PruneZone[TheHeap]] 
END; 

-- initialization code 

TheHeap ♦■ 

MakeNewZone[ SystemDefs .Alloc at ePages[l], 1*A1 toDef s .PageSize , SystemDefs .FreePages] ; 

END. 



